perm filename GEOMES.HDR[SAI,BGB]1 blob sn#029712 filedate 1973-03-16 generic text, type T, neo UTF8
00100	COMMENT LOAD GEOMES AND FRIENDS;
00200	
00300		REQUIRE "GEOMES.REL[GEO,BGB]" 	LOAD_MODULE;
00400		REQUIRE "WINGS.REL[GEO,BGB]" 	LOAD_MODULE;
00500		REQUIRE "EULER.REL[GEO,BGB]" 	LOAD_MODULE;
00600		REQUIRE "BIN.REL[GEO,BGB]" 	LOAD_MODULE;
00700		REQUIRE "EUCLID.REL[GEO,BGB]" 	LOAD_MODULE;
00800		REQUIRE "VIEWER.REL[GEO,BGB]" 	LOAD_MODULE;
00900		REQUIRE "OCCULT.REL[GEO,BGB]" 	LOAD_MODULE;
01000		REQUIRE "LS.REL[GEO,BGB]" 	LOAD_MODULE;
01100		REQUIRE "IO.REL[GEO,BGB]" 	LOAD_MODULE;
01200	
01300	COMMENT THE MACRO XCALL(NAME,ARGS);
01400	DEFINE XCALL(NAME,ARGS)=
01500	⊂ DEFINE _NAME="_"&"NAME";
01600		SIMPLE INTEGER PROCEDURE _NAME ARGS;
01700		BEGIN
01800			EXTERNAL SIMPLE INTEGER PROCEDURE NAME;
01900		START_CODE
02000			MOVEM '12,BGB12;
02100			MOVEM '16,BGB16;
02200			POP   '17,BGBRET;
02300			PUSHJ '17,NAME;
02400			MOVE  '12,BGB12;
02500			MOVE  '16,BGB16;
02600			JRST  @BGBRET;
02700		END;
02800		END;
02900			DEFINE NAME="_"&"NAME"
03000	⊃;
03100	
03200	COMMENT DECLARATIONS FOR GEOMES PROCEDURES;
03300	
03400		INTEGER BGB12,BGB16,BGBRET;
03500	
03600		XCALL(⊂MKNODE⊃,⊂(INTEGER TYP)⊃);
03700		XCALL(⊂KLNODE⊃,⊂(INTEGER NOD)⊃);
03800	
03900		DEFINE XWC(V)=⊂MEMORY[V-3,REAL]⊃;
04000		DEFINE YWC(V)=⊂MEMORY[V-2,REAL]⊃;
04100		DEFINE ZWC(V)=⊂MEMORY[V-1,REAL]⊃;
04200	
04300		DEFINE XPP(V)=⊂MEMORY[V+4,REAL]⊃;
04400		DEFINE YPP(V)=⊂MEMORY[V+5,REAL]⊃;
04500		DEFINE ZPP(V)=⊂MEMORY[V+6,REAL]⊃;
04600	
04700		DEFINE H1(X)=⊂ (X LSH -18)⊃;
04800		DEFINE H2(X)=⊂ (X LAND '777777)⊃;
04900	
05000		DEFINE NFACE(E)=⊂H1(MEMORY[E+1])⊃;
05100		DEFINE PFACE(E)=⊂H2(MEMORY[E+1])⊃;
05200		DEFINE NED(E)=⊂H1(MEMORY[E+2])⊃;
05300		DEFINE PED(E)=⊂H2(MEMORY[E+2])⊃;
05400		DEFINE NVT(E)=⊂H1(MEMORY[E+3])⊃;
05500		DEFINE PVT(E)=⊂H2(MEMORY[E+3])⊃;
05600	
     

00100	COMMENT WINGS;
00200	
00300		XCALL(⊂MKWORLD⊃,⊂⊃);
00400		XCALL(⊂MKWINDOW⊃,⊂⊃);
00500		XCALL(⊂MKCAMERA⊃,⊂⊃);
00600		XCALL(⊂MKLOCOR⊃,⊂⊃); 
00700	
00800		XCALL(⊂MKB⊃,⊂(INTEGER WORLD)⊃);
00900		XCALL(⊂KLB⊃,⊂(INTEGER BNEW)⊃);
01000		XCALL(⊂KLBFEV⊃,⊂(INTEGER Q)⊃);
01100	
01200		XCALL(⊂MKF⊃,⊂(INTEGER B)⊃);
01300		XCALL(⊂MKE⊃,⊂(INTEGER B)⊃);
01400		XCALL(⊂MKV⊃,⊂(INTEGER B)⊃);
01500	
01600		XCALL(⊂WING⊃,⊂(INTEGER E1,E2)⊃); 
01700		XCALL(⊂LINKED⊃,⊂(INTEGER Q1,Q2)⊃); 
01800	
01900		XCALL(⊂ECW⊃,⊂(INTEGER Q1,Q2)⊃); 
02000		XCALL(⊂ECCW⊃,⊂(INTEGER Q1,Q2)⊃); 
02100		XCALL(⊂OTHER⊃,⊂(INTEGER Q1,Q2)⊃); 
02200		XCALL(⊂OTHER_⊃,⊂(INTEGER Q,E,X)⊃); 
02300	
02400		XCALL(⊂BGET⊃,⊂(INTEGER Q)⊃); 
02500		XCALL(⊂BDET⊃,⊂(INTEGER Q1,Q2)⊃);
02600		XCALL(⊂BATT⊃,⊂(INTEGER Q1,Q2)⊃);
02700	
02800		XCALL(⊂VCW⊃,⊂(INTEGER E,F)⊃); 
02900		XCALL(⊂VCCW⊃,⊂(INTEGER E,F)⊃); 
03000		XCALL(⊂FCW⊃,⊂(INTEGER E,V)⊃); 
03100		XCALL(⊂FCCW⊃,⊂(INTEGER E,V)⊃); 
03200	
     

00100	COMMENT EULER;
00200	
00300		XCALL(⊂INVERT⊃,⊂(INTEGER E)⊃);
00400		XCALL(⊂EVERT⊃,⊂(INTEGER B)⊃);
00500	
00600		XCALL(⊂MKEV⊃,⊂(INTEGER F,V)⊃);
00700		XCALL(⊂MKFE⊃,⊂(INTEGER V1,F,V2)⊃);
00800		XCALL(⊂ESPLIT⊃,⊂(INTEGER E)⊃);
00900	
01000		XCALL(⊂KLFE⊃,⊂(INTEGER E)⊃);
01100		XCALL(⊂KLEV⊃,⊂(INTEGER V)⊃);
01200		XCALL(⊂KLVE⊃,⊂(INTEGER E)⊃);
01300	
01400		XCALL(⊂MKCOPY⊃,⊂(INTEGER B)⊃);
01500		XCALL(⊂GLUEE⊃,⊂(INTEGER F1,V1,F2,V2)⊃);
01600		XCALL(⊂GLUE⊃,⊂(INTEGER F1,F2)⊃);
01700	
01800		XCALL(⊂SWEEP⊃,⊂(INTEGER FCE,FLG)⊃);
01900		XCALL(⊂ROTCOM⊃,⊂(INTEGER F)⊃);
02000		XCALL(⊂PYRAMID⊃,⊂(INTEGER FV)⊃);
02100		XCALL(⊂REMOVF⊃,⊂(INTEGER F)⊃);
02200		XCALL(⊂FVDUAL⊃,⊂(INTEGER B)⊃);
     

00100	COMMENT EUCLID, IO, VIEWER AND OCCULT;
00200	
00300		XCALL(⊂ROTATE⊃,⊂(INTEGER OBJECT,TRAN)⊃);
00400		XCALL(⊂MKTRAN⊃,⊂(INTEGER REFRAM,OPAXCNT;REAL DELTA)⊃);
00500		XCALL(⊂IFORM1⊃,⊂⊃);
00600		XCALL(⊂OFORM1⊃,⊂(INTEGER B)⊃);
00700		
00800		XCALL(⊂SHOW1⊃,⊂(INTEGER WINDOW,GLASS)⊃);
00900		XCALL(⊂SHOW2⊃,⊂(INTEGER WINDOW,GLASS)⊃);
01000		XCALL(⊂PROJECTOR⊃,⊂(INTEGER CAMERA,WORLD)⊃);
01100		XCALL(⊂EMARKALL⊃,⊂(INTEGER WORLD)⊃);
01200		XCALL(⊂EMARK⊃,⊂(INTEGER WORLD)⊃);
01300		XCALL(⊂FMARK⊃,⊂(INTEGER WORLD)⊃);
01400		XCALL(⊂OCCULT⊃,⊂(INTEGER WORLD)⊃);
01500	
01600		XCALL(⊂KLJUTS⊃,⊂(INTEGER WORLD)⊃);
01700		XCALL(⊂KLJOTS⊃,⊂(INTEGER WORLD)⊃);
01800		XCALL(⊂KLTMPS⊃,⊂(INTEGER WORLD)⊃);
01900		XCALL(⊂CLIPER⊃,⊂(INTEGER WINDOW)⊃);
02000		XCALL(⊂IIIDPY⊃,⊂(INTEGER WINDOW,GLASS)⊃);
02100	
02200		XCALL(⊂BIN⊃,⊂(INTEGER B1,B2)⊃);
02300		XCALL(⊂BUN⊃,⊂(INTEGER B1,B2)⊃);
02400		XCALL(⊂BSUB⊃,⊂(INTEGER B1,B2)⊃);